;;##########################################################################
;; plugin.lsp
;; Copyright (c) 1999-2002 by Forrest W. Young
;; Code for Plugins
;;##########################################################################





;-------------------------------------------------------------------------
; define        vista-analysis-plugin-object-proto 
; inherits from analysis-plugin-object-proto
; provides for a simplified and more clearly structured plugin interface
;-------------------------------------------------------------------------

(defproto analysis-plugin-object-proto '(gossiper spreadplot) 
  () mv-model-object-proto)

(defproto vista-analysis-plugin-object-proto '() 
  () analysis-plugin-object-proto)

(defmeth vista-analysis-plugin-object-proto :isnew (title data-object dialog)
  (if (not (eq *current-data* data-object)) (setcd data-object))
  (let* ((plugnum (position title (send *vista* :plugin-menu-item-titles) :test #'equal))
         (name (select (send *vista* :plugins) plugnum))
         (prefix (select (send *vista* :plugin-model-prefix) plugnum))
         (data-types (select (send *vista* :plugin-data-types) plugnum))
         (variable-types (unless (send *vista* :plugin-ok-variable-types)) '(nil nil nil))
         (variable-types (select (send *vista* :plugin-ok-variable-types) plugnum))
         )
    (call-next-method title name prefix data-types data-object 
                      title name dialog variable-types))
  t)
  


;-------------------------------------------------------------------------
; define        analysis-plugin-object-proto 
; inherits from mv-model-object-proto
;-------------------------------------------------------------------------



(defmeth analysis-plugin-object-proto :isnew 
       (analyze-menu-item-name button-name model-prefix                        
        data-types data-object title name dialog ok-variable-types)
  (if (not (eq *current-data* data-object)) (setcd data-object))
#|
 | NOTE: Possible datatypes are:
 |         univariate, bivariate, multivariate, general,   crosstabs
 |         category,   class,     freqclass,    crosstabs, missing
 | 
 | MATRIX data probably do not work ... they have not been tested
 |        should inherit from 
 |           matrix-model-object-proto <- matrix-data-object-proto
 |#
  (when (not (member (send data-object :determine-data-type) 
                     data-types :test #'equal))        
        (let* ((str (format nil "The data type of the ~a data is ~s.  ~a requires data whose data-type is ~a"
                            (send data-object :name)
                            (send data-object :data-type) 
                            analyze-menu-item-name (first data-types)))
               (num-types (length data-types)))
          (when (> num-types 1)
                (dotimes (i (1- num-types))
                         (setf str (strcat str 
                                           (if (= i (- num-types 2)) 
                                               " or " ", ")))
                         (setf str (strcat str (select data-types (1+ i))))))
          (fatal-message str)))
;;need to check on variable types in multivariate data
  (send self :analyze-menu-item-name analyze-menu-item-name)
  (send self :button-name button-name)
  (send self :model-abbrev model-prefix)
  (send self :data-types data-types)
  (call-next-method button-name data-object 
                    title name dialog ok-variable-types)
  )



(defmeth analysis-plugin-object-proto :gossiper (&optional (obj-id nil set)) 
  (when set (setf (slot-value 'gossiper) obj-id)) 
  (slot-value 'gossiper))

(defmeth analysis-plugin-object-proto :spreadplot (&optional (obj-id nil set)) 
  (when set (setf (slot-value 'spreadplot) obj-id)) 
  (slot-value 'spreadplot))

(defmeth analysis-plugin-object-proto :make-object-id ()
  (format nil "#<Object: ~a;   ProcType: ~a-Plugin;   Subject: ~a~a>~%"
          (send self :full-name)
          (string-capitalize (send self :button-name))
          (send (send self :data-object) :full-name)
          (if (equal "matrix" (string-downcase (send self :data-type)))
              (format nil "[~ax~ax~a]" (send self :nobs) (send self :nobs) (send self :nmat))
              (format nil "[~ax~a]" (send self :nobs) (send self :nvar)))))


(defmeth analysis-plugin-object-proto :do-action ())

(defmeth analysis-plugin-object-proto :print (&rest args)
  (format t "~a" (send self :full-name)))


;-------------------------------------------------------------------------
; define        vista-diss-analysis-plugin-object-proto 
; inherits from mv-model-object-proto
; provides for a simplified and more clearly structured plugin interface
;-------------------------------------------------------------------------


(defproto vista-diss-analysis-plugin-object-proto '(gossiper spreadplot) 
  () mv-model-object-proto)


(defmeth vista-diss-analysis-plugin-object-proto :isnew (title data-object dialog)
  (if (not (eq *current-data* data-object)) (setcd data-object))
  (let* ((plugnum (position title (send *vista* :plugin-menu-item-titles) :test #'equal))
         (name (select (send *vista* :plugins) plugnum))
         (prefix (select (send *vista* :plugin-model-prefix) plugnum))
         (data-types (select (send *vista* :plugin-data-types) plugnum))
         (variable-types (unless (send *vista* :plugin-ok-variable-types)) '(nil nil nil))
         (variable-types (select (send *vista* :plugin-ok-variable-types) plugnum))
         ) 
    (unless (equal "matrix" (send data-object :determine-data-type))
            (fatal-message 
             (format nil "The data type of the ~a data is ~s.  ~a requires data whose data-type is Matrix"
                     (send data-object :name)
                     (send data-object :data-type) 
                     title)))
    (send self :analyze-menu-item-name title)
    (send self :button-name name)
    (send self :model-abbrev prefix)
    (send self :data-types data-types)
    (send self :variable-types variable-types)
    (call-method analysis-plugin-object-proto :isnew 
                 title name prefix data-types data-object 
                 title name dialog variable-types))
  t)


(defmeth vista-diss-analysis-plugin-object-proto :gossiper (&optional (obj-id nil set)) 
  (when set (setf (slot-value 'gossiper) obj-id)) 
  (slot-value 'gossiper))

(defmeth vista-diss-analysis-plugin-object-proto :spreadplot (&optional (obj-id nil set)) 
  (when set (setf (slot-value 'spreadplot) obj-id)) 
  (slot-value 'spreadplot))

(defmeth vista-diss-analysis-plugin-object-proto :make-object-id ()
  (format nil "#<Object: ~a;   ProcType: ~a-Plugin;   Subject: ~a~a>~%"
          (send self :full-name)
          (string-capitalize (send self :button-name))
          (send (send self :data-object) :full-name)
          (if (equal "matrix" (string-downcase (send self :data-type)))
              (format nil "[~ax~ax~a]" (send self :nobs) (send self :nobs) (send self :nmat))
              (format nil "[~ax~a]" (send self :nobs) (send self :nvar)))))


(defmeth vista-diss-analysis-plugin-object-proto :do-action ())

(defmeth vista-diss-analysis-plugin-object-proto :print (&rest args)
  (format t "~a" (send self :full-name)))



;====================
; VISTA SYSTEM OBJECT METHODS TO INSTALL PLUGIN
;=======================

(defmeth vista-system-object-proto :prepare-plugin-environment
  (plugin-subdirectory-name plugin-file-name menu-item-title tool-name model-prefix ok-data-types ok-variable-types)

  (set (intern (string-upcase (strcat "*" tool-name "-plugin-constructor-file*")))
       (strcat *plugin-path* plugin-subdirectory-name separator plugin-file-name))

  (set (intern (string-upcase (strcat "*" tool-name "-plugin-path*")))
       (strcat *plugin-path* plugin-subdirectory-name separator))

  (send self :install-plugin 
        tool-name menu-item-title ok-data-types 
        ok-variable-types model-prefix))

;:plugin-ok-variable-types :plugin-model-prefix 
 
(defmeth vista-system-object-proto :install-plugin 
           (tool-name menu-item-title ok-data-types &optional
                      ok-variable-types model-prefix)
  (send self :plugins (combine (send self :plugins) tool-name))
  (unless (send self :plugin-model-prefix) 
          (send self :plugin-model-prefix '("Anv" "Reg" "Uni")))
  (send self :plugin-model-prefix
        (append (send self :plugin-model-prefix) (list model-prefix)))
  (unless (send self :plugin-ok-variable-types) 
          (send self :plugin-ok-variable-types '(nil nil nil)))
  (send self :plugin-ok-variable-types
        (append (send self :plugin-ok-variable-types) (list ok-variable-types)))
  (send self :plugin-menu-item-titles 
        (add-element-to-list (send self :plugin-menu-item-titles)
                             menu-item-title))
  (send self :plugin-data-types 
        (add-element-to-list (send self :plugin-data-types) ok-data-types))
  
  (let ((tool (send toolbar-icon-proto :new tool-name))
        (item (send expert-menu-item-proto :new (strcat menu-item-title " ...")))
        (prev-plugs (send self :previous-plugins))
        (num-buts (send *workmap* :num-toolbar-buts))
        (objids))
    (send *analyze-menu* :append-items item)
    (send item :make-action menu-item-title)
    (send *toolbox* :append-tool tool)
    (send tool :make-action menu-item-title)
    (send *workmap* :num-toolbar-buts (1+ (send *workmap* :num-toolbar-buts)))
    (send *toolbar* :num-icons (send *workmap* :num-toolbar-buts))
    (setf *nplugins* (1+ *nplugins*))
    (cond
      ((member tool-name prev-plugs :test #'equal)
       )
      (t
       ;(unless (< *run-number* 2)
       ;        (message-dialog (format nil "A new plugin for ~s has been detected.~%A new item has been added to the Analyze Menu." menu-item-title)))
       (setf *plugins-changed* t)
       (send *workmap* :redraw)))
    (when *verbose* (print (list "*nplugins* (send *toolbar* :num-icons) (send *workmap* :num-toolbar-buts) *num-toolbar-buts-shown-at-startup*" *nplugins* (send *toolbar* :num-icons) (send *workmap* :num-toolbar-buts) *num-toolbar-buts-shown-at-startup*)) (terpri))
    ))

(defmeth expert-menu-item-proto :make-action (title)
  (when title 
        (let* ((action-title
                (string-upcase 
                 (blanks-to-dashes 
                  (remove-period title)))))
          (send self :action #'(lambda () 
                                 (send *vista* :plugin-dialog t)
                                 (funcall (symbol-function (intern action-title))
                                          :dialog t)
                                 )))))

#|This method is in toolbar.lsp. It is here only for example to construct new dialog
(defmeth toolbox-overlay-proto :change-button-function (i &optional choice)
  (let* ((icon-list (copy-list (send self :icon-list)))
         (but-names (copy-list (send self :button-name-list)))
         (data-types-list (copy-list (send self :data-types-list)))
         (menu-item-list (send *vista* :remove-dash-menu-items *analyze-menu*))
         (icon-list-master (copy-list (send self :icon-list-master)))
         (but-name-master (send self :button-name-master))
         (data-types-master (copy-list (send *vista* :plugin-data-types)))
         (but (select icon-list-master i))
         (soft (send self :enable-soft-buttons))
         (title-list))
    (send self :enable-soft-buttons nil)
    (when (not choice)
          (setf title-list (copy-list (mapcar #'(lambda (menu-item)
                (remove-period (send menu-item :title)))
                                        menu-item-list)))
          (setf choice (choose-item-dialog 
                        "Choose an Analysis for this Button:"
                                     title-list)))
    (when choice (send self :change-button i choice))
    (send self :enable-soft-buttons soft)
    ))
|#

(defmeth toolbox-overlay-proto :change-button (i choice)
  (let* ((but-name-master (send self :button-name-master))
         (data-types-master (copy-list (send *vista* :plugin-data-types)))
         (icon-list-master (copy-list (send self :icon-list-master)))
         (icon-list (copy-list (send self :icon-list)))
         (but-names (copy-list (send self :button-name-list)))
         (data-types-list (copy-list (send self :data-types-list)))
         ;(menu-item-list (send *vista* :remove-dash-menu-items *analyze-menu*))
         )
    (setf (select but-names  i) (select but-name-master choice))
    (setf (select data-types-list i) (select data-types-master choice))
    (setf (select icon-list i) (select icon-list-master choice))
    (send self :icon-list icon-list)
    (send self :button-name-list but-names)
    (send self :data-types-list data-types-list)
    (mapcar #'(lambda (but name )
                (send but :title name))
            icon-list but-names )
    (send self :soft-button-titles but-names)))

(defmeth toolbox-overlay-proto :set-new-buttons-shown (selected-but-nums)
  (let ((nbuts (length selected-but-nums)))
    (send self :enable-soft-buttons nil)
    (setf *num-toolbar-buts-shown-at-startup*  nbuts)
    (dotimes (i nbuts) (send self :change-button i (select selected-but-nums i)))
    (send self :num-icons nbuts) 
    (send *workmap* :num-toolbar-buts nbuts)
    (send self :enable-soft-buttons t)
    ))

(defmeth toolbox-overlay-proto :toolbar-button-dialog (text)
  (let* (
         (but-name-master (send self :button-name-master))
         (data-types-master (copy-list (send *vista* :plugin-data-types)))
         (box-text-item (send text-item-proto :new  text))
         (selectable-text-item (send text-item-proto :new "Selectable Buttons"))
         (selected-text-item (send text-item-proto :new "Selected Buttons"))
         (num-buts-see (send self :num-icons-shown ))
         (num-buts-max (send self :num-icons))
         (selectable-but-nums (iseq num-buts-max))
         (selected-but-nums)
         (selectable-but-items (send list-item-proto :new but-name-master))
         (selected-but-items   (send list-item-proto :new (repeat " " num-buts-max)))
         
         (ok        (send modal-button-proto :new "OK"))
         (cancel    (send modal-button-proto :new "Cancel"))
         (but-dialog (send modal-dialog-proto :new
                           (list box-text-item
                                 (list (list selectable-text-item 
                                             selectable-but-items)
                                       (list selected-text-item 
                                             selected-but-items))
                                 (list ok cancel))
                           :default-button ok)))

     (defmeth ok :do-action ()
      (let ((dialog (send ok :dialog))
            (nbuts)
            )
        (cond
          (selected-but-nums
           (send *toolbar* :set-new-buttons-shown selected-but-nums)
          ; (send *toolbar* :enable-soft-buttons nil)
          ; (setf nbuts (length selected-but-nums))
          ; (setf *num-toolbar-buts-shown-at-startup*  nbuts)
          ; (dotimes (i nbuts)
          ;          (setf choice (select selected-but-nums i))
          ;          (send *toolbox* :change-button i choice)
          ;          )
          ; (send *toolbar* :num-icons nbuts) 
          ; (send *workmap* :num-toolbar-buts nbuts)
          ; (send *toolbar* :enable-soft-buttons t)
           (send dialog :modal-dialog-return t)
           )
          (t
           (error-message "You must select at least one analysis button.")
           (send dialog :modal-dialog-return nil))
          )))


    (defmeth cancel :do-action ()
      (let ((dialog (send cancel :dialog)))
        (send dialog :modal-dialog-return nil)))

    
    (defmeth selectable-but-items :do-action (&optional dbl-clk)
      (let* ((n (send self :selection))
             (s (select (send self :slot-value 'list-data) n))
             (m nil))
        (when (and n (not (equal s " ")))
              (send self :set-text n " ") ;OK
              (setf m (position " " 
                        (send selected-but-items :slot-value 'list-data)
                                :test 'equal))
              (send selected-but-items :set-text m s)
              (setf selected-but-nums 
                    (concatenate 'list selected-but-nums (list n))))
        (send self :selection nil)))

    (defmeth selected-but-items :do-action (&optional dbl-clk)
      (let* ((n (send self :selection))
             (L (length selected-but-nums))
             (s nil)
             (m nil))
        (when n
              (setf s (select (send self :slot-value 'list-data) n))
              (when (> L n) 
                    (setf m (select selected-but-nums n))
                    (when (< n (1- L))
                          (dolist (i (iseq n (- L 2)))
                                  (send self :set-text i 
                                        (select (send self :slot-value 
                                                      'list-data) (1+ i)))))
                    (send self :set-text (1- L) " ")
                    (send selectable-but-items :set-text m s)
                    (setf selected-but-nums (remove m selected-but-nums)))
                    (send self :selection nil)
              )))

    (if (send but-dialog :modal-dialog)
        (select but-name-master  selected-but-nums)
        nil)
    ))

;-------------------------------------------------------------------------
; define transformation-plugin-object-proto 
; inheriting from model-plugin-object-proto
;-------------------------------------------------------------------------


(defproto transformation-plugin-object-proto () () analysis-plugin-object-proto)

(defmeth transformation-plugin-object-proto :isnew (&rest args)
  (send self :transf-obj? t)
  (send self :model-abbrev (select args 3))
  (send self :new-object)
  (setf (select args 0) (select args 3))
  (setf (select args 3) nil)
  (apply #'call-next-method args))

;more code needed to finish this